00100		DIMENSION II(1024),JJ(1024),KK(1024),LL(1024),KP(5),NN(4096)
00200		1,A(384),B(384),IB(1024)
00300		COMMON KP,NP,NN,JF
00400		IMP(I)=IABS(NN(I)/100000000)
00500	1	JE=0
00600		MN=0
00700		IP=-1
00800		MO=0
00900		NZ=10
01000		IM=0
01100		JF=0
01200		IS=-1
01300		NF=0
01400		LF=1
01500		CALL DPYCLR
01600		CALL TYPLOC(-350,-511)
01700		DO 407 I=1,4
01800	407	KP(I)='     '
01900		CALL DPYSET(4,LL,1000)
02000		CALL DPYSET(3,KK,1000)
02100		CALL DPYSET(2,JJ,1000)
02200		CALL DPYSET(1,II,1000)
02300		MN=0
02400	2	TYPE 5
02500	5	FORMAT(' TYPE:<CR>;TO DRAW NEW PICTURE.'/
02600		1' OR TYPE IN NAME TO USE OLD PICTURE.'/)
02700		ACCEPT 3,NAM
02800	3	FORMAT(A5)
02900		IF(NAM.EQ.'     ')GO TO 140
03000	   	IF(.NOT.LOOKD(NAM))GO TO 2
03100	515	CALL IFILE(1,NAM)
03200		READ(1)LE,(NN(K),K=MN+1,MN+LE)
03300		MN=MN+LE
03400		IP=-1
03500		IF(MO.NE.'P')GO TO 517
03600		MO=100000000
03700		DO 518 K=MN-LE+1,MN
03800		MP=1
03900		IF(NN(K))MP=-1
04000		NN(K)=IABS(NN(K))
04100	518	NN(K)=MP*(NP*MO+(MOD(NN(K),MO)))
04200		GO TO 503
04300	517	DO 388 K=1,MN
04400		NP=MOD(IMP(K),10)
04500		CALL SETPOG(NP)
04600		CALL INXY(NX,NY,K)
04700		MP=1
04800		IF(NN(K))MP=-1
04900	388	CALL IPEN(NX,NY,MP,NZ)
05000	   	DO 193 I=1,4
05100		KP(I)='VIS  '
05200	193	CALL DPYOUT(I)
05300		CALL SETPOG(1)
05400	140	NP=1
05500		CALL IPOG(NZ)
05600	
05700	211	NS=0
05800	120	LV=0
05900	144	CALL SETCUR(NX,NY,LV)
06000		IF(NS)TYPE 6
06100	6	FORMAT(' :'$)
06200		IF(JF.GT.0)TYPE 634
06300	634	FORMAT(' O'$)
06400		ACCEPT 103,M,N
06500	103	FORMAT(2A1)
06600		LX=NX
06700		LY=NY
06800		CALL RDCUR(NX,NY)
06900		IF(NC)GO TO 191
07000		IF(M.NE.' ')GO TO 11
07100	308	IF(LV.NE.0)GO TO 192
07200	301	CALL IPAK(NX,NY,MN,1,NZ)
07300		LV=1
07400		GO TO 144
07500	192 	CALL IPAK(NX,NY,MN,-1,NZ)
07600	341	N=NP
07700	278	CALL DPYOUT(N)
07800		KP(N)='VIS  '
07900	360	IF(IP)CALL IPOG(NZ)
08000	260	IF(NS)GO TO 144
08100		GO TO 120
08200	
08300	11	IF(M.EQ.':')GO TO 261
08400		IF(M.EQ.'.')GO TO 303
08500		IF(M.EQ.'W')GO TO 380
08600	  	IF(M.EQ.'H')GO TO 306
08700		IF(M.EQ.'V')GO TO 307
08800		IF(M.EQ.'B')GO TO 105
08900	  	IF(M.EQ.'C')GO TO 150
09000		IF(M.EQ.'+')GO TO 500
09100		IF(M.EQ.'-')GO TO 501
09200		IF(M.EQ.'*')GO TO 502
09300		IF(M.EQ.'J')GO TO 608
09400		IF(M.EQ.'O')GO TO 630
09500		IF(M.EQ.'A')GO TO 510
09600		IF(M.EQ.'E')GO TO 425
09700		IF(M.EQ.'G')GO TO 799
09800		IF(M.EQ.'(')GO TO 431
09900		IF(M.EQ.')')GO TO 432
10000	  	IF(M.EQ.'I'.OR.M.EQ.'S')GO TO 230
10100		IF(M.EQ.'X')GO TO 104
10200		IF(M.EQ.'Z')GO TO 580
10300		IF(M.EQ.'F')GO TO 601
10400		IF(M.NE.'P')GO TO 260
10500		IP=-1
10600		IF(N.EQ.'I')GO TO 258
10700		IF(N.EQ.'D')GO TO 340
10800		IF(N.NE.' ')GO TO 231
10900	259	NP=NP+1
11000		IF(NP.GT.4)NP=1
11100	251	CALL SETPOG(NP)
11200		GO TO 503
11300	630	IF(JF.GT.0)GO TO 701
11400		REREAD 710,M,JF
11500	710	FORMAT(A1,I2)
11600		IF(JF.LT.1.OR.JF.GT.19.OR.JF.EQ.10)JF=1
11700		GO TO 261
11800	701	JF=0
11900		GO TO 211
12000	303	IF(LV.EQ.0)GO TO 301
12100		CALL IPAK(NX,NY,MN,-1,NZ)
12200	333	KP(NP)='VIS  '
12300		IF(IP)CALL IPOG(NZ)
12400		CALL DPYOUT(NP)
12500		NX=LX
12600		NY=LY
12700		IF(.NOT.NC)GO TO 301
12800		NC=0
12900		GO TO 211
13000	601	IT=0
13100	702	IT=IT+1
13200		IF(IT.GT.19)GO TO 708
13300		IF(IT.EQ.10)IT=11
13400		I=0
13500		K=0
13600	602	I=I+1
13700		IF(I.GT.MN)GO TO 660
13800	606	IF(MOD(IMP(I),10).NE.NP)GO TO 602
13900		IF(IMP(I)/10.NE.IT)GO TO 602
14000		K=K+1
14100		CALL INXY(N,M,I)
14200		IF(IT.GT.10)CALL INXY(M,N,I)
14300		A(K)=N*NZ/10
14400		B(K)=M*NZ/10
14500		IB(K)=3
14600		IF(NN(I))IB(K)=2
14700		I=I+1
14800		IF(I.LE.MN)GO TO 606
14900	660	IF(K.LT.3)GO TO 702
15000		IB(1)=K
15100		JI=IT
15200		IF(IT.GT.10)JI=IT-10
15300		IF(IS)JI=JI+5
15400		CALL FILLER(A,B,IB,JI,IS,IT,LD,LS)
15500		GO TO 702
15600	708	IF(IS)GO TO 341
15700		GO TO 689
15800	608	NV=-1
15900		IF(LV.EQ.0)NV=1
16000		CALL IPAK(JX,JY,MN,NV,NZ)
16100		NX=JX
16200		NY=JY
16300		GO TO 341
16400	306	NY=LY
16500		GO TO 308
16600	307	NX=LX
16700		GO TO 308
16800	230	IF(N.EQ.' ')GO TO 258
16900	231	IF(N.LT.'1'.OR.N.GT.'4')GO TO 255
17000		REREAD 408,M,N
17100	408	FORMAT(A1,I1)
17200		IF(M.EQ.'S')GO TO 278
17300	   	IF(M.NE.'I')GO TO 256
17400	257	KP(N)='     '
17500		CALL HYDPOG(N)
17600		IF(M.EQ.'P')GO TO 259
17700		GO TO 360
17800	255	IF(M.EQ.'P')GO TO 259
17900	258	IF(M.EQ.'S')GO TO 341
18000		N=NP
18100		GO TO 257
18200	256	NP=N
18300		GO TO 251
18400	261	IF(NS)GO TO 211
18500		NS=-1
18600		IF(LV.EQ.1)GO TO 666
18700		JX=NX
18800		JY=NY
18900		GO TO 301
19000	666	JX=LX
19100		JY=LY
19200		GO TO 192
19300	580	IF(IP)GO TO 581
19400		IP=-1
19500		GO TO 360
19600	581	IP=0
19700		N=5
19800		GO TO 257
19900	500	IF(NZ.EQ.20)GO TO 503
20000		NZ=NZ+1
20100		GO TO 503
20200	501	IF(NZ.EQ.5)GO TO 503
20300		NZ=NZ-1
20400		GO TO 503
20500	502	IF(NZ.EQ.10)GO TO 503
20600		NZ=10
20700	503	CALL CLRPOG(NP)
20800		CALL IDRA(MN,NZ)
20900	335	NS=0
21000		GO TO 341
21100	510	REREAD 516,MO,NAM
21200	516	FORMAT(1XA1,A5)
21300		IF(MO.EQ.'G')GO TO 778
21400		IF(.NOT.LOOKD(NAM))GO TO 260
21500		GO TO 515
21600	778	CALL GETFIL(NAM)
21700		CALL FASTIN(IB,2)
21800		MS=IB(2)
21900		CALL GETFIL(NAM)
22000		CALL FASTIN(IB,MS+2)
22100		CALL GETP(IB,NN(MN+1))
22200		DO 777 K=MN+1,MN+MS
22300		I=NP*100000000
22400		IF(NN(K))I=-I	
22500	777	NN(K)=NN(K)+I	
22600		MN=MN+MS
22700		GO TO 503
22800	340	CALL CLRPOG(NP)
22900		J=0
23000	400	J=J+1
23100	507	IF(J.GT.MN)GO TO 466
23200		MP=MOD(IMP(J),10)
23300		IF(MP.NE.NP)GO TO 400
23400		DO 401 I=J,MN-1
23500	401	NN(I)=NN(I+1)
23600		MN=MN-1
23700		GO TO 507
23800	466	IF(JE)GO TO 467
23900		IP=-1
24000		GO TO 431
24100	105	LP=MOD(IMP(MN),10)
24200		IF(MN.LT.1.OR.LP.NE.NP)GO TO 335
24300		IF(NP.EQ.1)II(2)=II(2)-1
24400		IF(NP.EQ.2)JJ(2)=JJ(2)-1
24500		IF(NP.EQ.3)KK(2)=KK(2)-1
24600		IF(NP.EQ.4)LL(2)=LL(2)-1
24700	        CALL ACCPOG(NP)
24800		MN=MN-1
24900		LV=0
25000		IF(NN(MN))LV=1
25100		GO TO 341
25200	150	NC=-1
25300		IF(LV.NE.1)GO TO 301
25400	191	R=0
25500		MN=MN-1
25600		RM=(NX-LX)**2+(NY-LY)**2
25700		RM=SQRT(RM)
25800		KX=LX+RM*SIND(R)
25900		KY=LY+RM*COSD(R)
26000		CALL IPAK(KX,KY,MN,1,NZ)
26100		DO 151 K=6,360,6
26200		R=K
26300		KX=LX+RM*SIND(R)
26400		KY=LY+RM*COSD(R)
26500	151	CALL IPAK(KX,KY,MN,-1,NZ)
26600		GO TO 333
26700	380	IF(LV.NE.1)GO TO 103
26800		REREAD 377,M,N
26900	377	FORMAT(A1,I2)
27000		IF(N.LT.4)N=100
27100		KN=N/10
27200		IF(KN.LT.2)KN=2
27300		DO 381 I=0,N,KN
27400		CALL IPAK(LX-N/2+I,LY-N/2+I,MN,1,NZ)
27500	381	CALL IPAK(NX-N/2+I,NY-N/2+I,MN,-1,NZ)
27600		GO TO 341
27700	799	LX=NX*10/NZ
27800		LY=NY*10/NZ
27900		I=MN
28000		NY=1000
28100		DO 801 K=1,MN
28200		CALL INXY(JX,JY,K)
28300		NX=IABS(JX-LX)+IABS(JY-LY)
28400		IF(NY.LT.NX)GO TO 801
28500		I=K
28600		NY=NX
28700	801	CONTINUE
28800		LF=0
28900		MP=NP
29000		IN=1
29100		GO TO 548
29200	813	IN=-1
29300		I=MN+1
29400		GO TO 426
29500	425	I=0
29600		MP=NP
29700		IF(N.EQ.'E')GO TO 813
29800		IN=1
29900	426	I=I+IN
30000	784	IF(I.GT.MN.OR.I.LT.1)GO TO 804
30100	548	CALL INXY(NX,NY,I)
30200		CALL SETCUR(NX*NZ/10,NY*NZ/10,1)
30300	794	IF(IN)TYPE 815
30400	815	FORMAT(' -'/)
30500		TYPE 469
30600	469	FORMAT(' EDIT?'$)
30700		ACCEPT 103,M,N
30800		IF(M.EQ.' ')GO TO 426
30900		IF(M.EQ.'-')GO TO 810
31000		IF(M.EQ.'+')GO TO 783
31100		IF(M.EQ.'D')GO TO 470
31200		IF(M.EQ.'I')GO TO 547
31300		IF(M.EQ.'O')GO TO 782
31400		IF(M.EQ.'C')GO TO 800
31500		IF(M.EQ.':')GO TO 790
31600		IF(M.EQ.')')GO TO 900
31700		CALL RDCUR(NX,NY)
31800		IF(M.EQ.'M')GO TO 780
31900		IF(M.NE.'B')GO TO 804
32000		I=I-IN
32100		GO TO 548
32200	804	NP=MP
32300		GO TO 211
32400	810	IN=-IN
32500		GO TO 426
32600	900	IF(IN)GO TO 901
32700		IM=I
32800		NF=LF
32900		GO TO 794
33000	901	IM=LF
33100		NF=I
33200		GO TO 794
33300	800	IF(LF.EQ.0.OR.LF.GT.MN)LF=I
33400		NP=MP
33500		DO 806 K=LF,I,IN
33600		CALL INXY(NX,NY,K)
33700		JF=IMP(K)/10
33800		MS=1
33900		IF(NN(K))MS=-1
34000	806	CALL IPAK(NX,NY,MN,MS,10)
34100	814	JF=0
34200		LF=0
34300		GO TO 471
34400	790	LF=I
34500		GO TO 794
34600	780	JF=IMP(I)/10
34700		LF=I
34800		NX=NX*10/NZ
34900		NY=NY*10/NZ
35000		GO TO 786
35100	783	REREAD 377,M,N
35200		I=I+IN*N
35300		GO TO 784
35400	782	REREAD 377,M,JF
35500		IF(JF.OR.JF.EQ.10.OR.JF.GT.19)JF=0
35600		IF(LF.EQ.0.OR.LF.GT.MN)LF=I
35700	796	CALL INXY(NX,NY,LF)
35800	786	MS=1
35900		IF(NN(LF))MS=-1
36000		NP=MOD(IMP(LF),10)
36100		LF=LF-1
36200		CALL IPAK(NX,NY,LF,MS,10)
36300		LF=LF+IN
36400		IF(IN.AND.(LF-I))GO TO 814
36500		IF(.NOT.IN.AND.(I-LF))GO TO 814
36600		GO TO 796
36700	547	NN(I)=-NN(I)
36800		GO TO 471
36900	470	MN=MN-1
37000		DO 428 K=I,MN
37100	428	NN(K)=NN(K+1)
37200	471	CALL CLRPOG(NP)
37300		CALL IDRA(MN,NZ)
37400		CALL DPYOUT(NP)
37500		GO TO 784
37600	431	NX=0
37700		NY=0
37800		NF=MN+1
37900		IM=0
38000		GO TO 211
38100	432	IF(IM.EQ.0)IM=MN
38200		DO 433 I=NF,IM
38300		JF=IMP(I)/10
38400		CALL INXY(IX,IY,I)
38500		IX=NX+IX
38600		IY=NY+IY
38700		MP=1
38800		IF(NN(I))MP=-1
38900	433	CALL IPAK(IX,IY,MN,MP,NZ)
39000		JF=0
39100		GO TO 341
39200	
39300	104	CALL CLRCUR
39400		CALL IPOG(NZ)
39500		IP=-1
39600	   	TYPE 111
39700	111	FORMAT(' TYPE:<CR>;TO CONTINUE.'/' TYPE:''N''<CR>;TO START OVER.'/
39800		2' TYPE:''X'' TO SAVE VIS POGS IF FINISHED'/
39900		3' OR TYPE:''P'' TO PLOT ALL VIS POGS'/)
40000		ACCEPT 103,M,NV
40100		IF(M.EQ.'N')GO TO 1
40200		IF(M.EQ.'P')GO TO 557
40300		IF(M.NE.'X')GO TO 120
40400	127	TYPE 121
40500	121	FORMAT(' TYPE A FIVE LETTER NAME FOR THIS PICTURE.'/)
40600		ACCEPT 3,NAM
40700		IF(NAM.EQ.'     ')GO TO 127
40800	557	MP=0
40900		DO 405 IK=1,4
41000		IF(KP(IK).NE.'VIS  ')GO TO 405
41100		MP=MP+1
41200	405	CONTINUE
41300		IF(MP.EQ.0)GO TO 104
41400		IF(M.EQ.'P')GO TO 555
41500		NP=0
41600		JE=-1
41700	467	NP=NP+1
41800		IF(NP.GT.4)GO TO 468
41900		IF(KP(NP).NE.'VIS  ')GO TO 340
42000		GO TO 467
42100	468	CALL OFILE(1,NAM)
42200		WRITE(1)MN,(NN(K),K=1,MN)
42300		END FILE 1
42400		GO TO 1
42500	555	TYPE 587
42600	587	FORMAT(/' PLOTING CURRENT POG'/)
42700		CALL PLOTS(I)
42800		IF(NV.EQ.'L')GO TO 797
42900		IF(NV.EQ.'S')GO TO 850
43000		IF(NV.NE.'D'.AND.NV.NE.'B')GO TO 851
43100		LD=-1
43200	850	LS=-1
43300	851	IS=0
43400		GO TO 601
43500	689	IF(NV.EQ.'S'.OR.NV.EQ.'D'.OR.NV.EQ.'Z')GO TO 711
43600	797	DO 556 I=1,MN
43700		IF(MOD(IMP(I),10).NE.NP)GO TO 556
43800		CALL INXY(NX,NY,I)
43900		MO=3
44000		IF(NN(I))MO=2
44100		CALL PLOT(NX*NZ/10,NY*NZ/10,MO)
44200	556	CONTINUE
44300	711	CALL PLOT(0,0,3)
44400		TYPE 691
44500	691	FORMAT(' FINISHED PLOTING!'/)
44600		IS=-1
44700		LS=0
44800		LD=0
44900		GO TO 211
45000		END
45100	
45200		SUBROUTINE IPOG(NZ)
45300		COMMON KP(5),NP,NN(4096),JF
45400		DIMENSION MM(24),JP(4)
45500		CALL DPYSET(5,MM,24)
45600		CALL DPYTXT(100,-430,'POG1 POG2 POG3 POG4 ZOOM ',5)
45700		KP(5)=' REG '
45800		IF(NZ.LT.10)KP(5)=' --- '
45900		IF(NZ.GT.10)KP(5)=' +++ '
46000		CALL DPYTXT(100,-450,KP,5)
46100		DO 4 J=1,4
46200		JP(J)='     '
46300	4	IF(J.EQ.NP)JP(J)=' ↑↑  '
46400		CALL DPYTXT(100,-470,JP,4)
46500		CALL DPYOUT(5)
46600		CALL SETPOG(NP)
46700		RETURN
46800		END
46900		SUBROUTINE IPAK(NX,NY,MN,MP,NZ)
47000		COMMON KP(5),NP,NN(4096),JF
47100		MN=MN+1
47200		IX=(NX*10/NZ)+1024
47300		IY=(NY*10/NZ)+1024
47400		NN(MN)=MP*((JF*10+NP)*100000000+IX*10000+IY)
47500		CALL IPEN(NX,NY,MP,10)
47600		RETURN
47700		END
47800		SUBROUTINE IPEN(NX,NY,MP,NZ)
47900		IX=NX*NZ/10
48000		IF(IX.GT.950)IX=950
48100		IF(IX.LT.-950)IX=-950
48200		IY=NY*NZ/10
48300		IF(IY.GT.950)IY=950
48400		IF(IY.LT.-950)IY=-950
48500		IF(MP)GO TO 1
48600		CALL AIVECT(IX,IY)
48700		RETURN
48800	1	CALL AVECT(IX,IY)
48900		RETURN
49000		END
49100		SUBROUTINE INXY(NX,NY,MN)
49200		COMMON KP(5),NP,NN(4096),JF
49300		J=IABS(NN(MN))
49400		NY=MOD(J,10000)-1024
49500		NX=(MOD(J,100000000)/10000)-1024
49600		RETURN
49700		END
49800		SUBROUTINE IDRA(MN,NZ)
49900		COMMON KP(5),NP,NN(4096),JF
50000		DO 1 I=1,MN
50100		KF=MOD(IABS(NN(I)/100000000),10)
50200		IF(KF.NE.NP)GO TO 1
50300		CALL INXY(IX,IY,I)
50400		CALL IPEN(IX,IY,NN(I),NZ)
50500	1	CONTINUE
50600		RETURN
50700		END